home *** CD-ROM | disk | FTP | other *** search
/ Technotools / Technotools (Chestnut CD-ROM)(1993).ISO / lang_oth / tasking / tasks.mod < prev   
Text File  |  1986-07-21  |  2KB  |  81 lines
  1. IMPLEMENTATION MODULE Tasks[7]; (* includes timeslices *)
  2.   (*
  3.     Written by Lloyd Miller Apr 86
  4.  
  5.     Warning. This takes over the timer interupt 1CH. Other
  6.     software using this interupt will be locked out for the period
  7.     that a program with this module is running. eg spoolers.
  8.     It should be possible to have this pass the signal along politly but
  9.     I didn't want to complicate it too much right at first.
  10.  
  11.     For some reason, this module has problems running with Borland's
  12.     SideKick.
  13.  
  14.     A similar IOTRANSFER could be used for the PC-AT "busy wait" BIOS interupt.
  15.     Just duplicate the timer routine and change the interupt vector and
  16.     initialize it the same as the timer.
  17.   *)
  18.  
  19.   FROM Devices IMPORT InstallHandler;
  20.   FROM SYSTEM IMPORT
  21.     ADDRESS, ADR, PROCESS, NEWPROCESS, TRANSFER, IOTRANSFER;
  22.   FROM Storage IMPORT ALLOCATE;
  23.  
  24.   TYPE
  25.     prcsptr = POINTER TO process;
  26.     process = RECORD
  27.       realProcess: PROCESS;
  28.       workSpacePtr: ADDRESS;
  29.       next: prcsptr;
  30.     END;
  31.  
  32.   VAR
  33.     curprocess: prcsptr;
  34.  
  35.   PROCEDURE NewTask(prcs: PROC; size: CARDINAL);
  36.     (* add prcs to circular list *)
  37.     VAR
  38.       newp: prcsptr;
  39.     BEGIN
  40.       NEW(newp);
  41.       WITH newp^ DO
  42.     ALLOCATE(workSpacePtr, size);
  43.     NEWPROCESS(prcs, workSpacePtr, size, realProcess);
  44.         next := curprocess^.next;
  45.       END;
  46.       curprocess^.next := newp;
  47.     END NewTask;
  48.  
  49.   PROCEDURE NextTask;
  50.     VAR
  51.       lastp: prcsptr;
  52.     BEGIN
  53.       lastp := curprocess;
  54.       curprocess := curprocess^.next;
  55.       TRANSFER(lastp^.realProcess, curprocess^.realProcess);
  56.     END NextTask;
  57.  
  58.   VAR
  59.     work, timer: PROCESS;
  60.     timerWKSP: ARRAY [1 .. 250] OF CARDINAL; (* 500 byte workspace *)
  61.  
  62.   PROCEDURE timerISR; (* timer interupt service routine *)
  63.     VAR
  64.       nextp: prcsptr;
  65.     BEGIN
  66.       InstallHandler(timer, 1CH);
  67.       LOOP (* forever ?! *)
  68.     IOTRANSFER(timer, work, 1CH); (* bios timer interupt *)
  69.     curprocess^.realProcess := work;
  70.         curprocess := curprocess^.next;
  71.         work := curprocess^.realProcess;
  72.       END; (* loop forever *)
  73.     END timerISR;
  74.  
  75.   BEGIN
  76.     NEW(curprocess);
  77.     curprocess^.next := curprocess; (* link to self *)
  78.     NEWPROCESS(timerISR, ADR(timerWKSP), 500, timer);
  79.     TRANSFER(work, timer);
  80.   END Tasks.
  81.